home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_asm / disasm / music.bas < prev    next >
BASIC Source File  |  1988-06-03  |  17KB  |  219 lines
  1. 10 REM DSNAME = MUSIC.BAS
  2. 20 REM This version completed on 6/20/82.  For comments and suggestions,
  3. 30 REM please contact Bruce Guthrie by mail at
  4. 40 REM   P.O. Box 710
  5. 50 REM   Washington, D.C. 20044
  6. 60 REM Copyright 1982 by Bruce Guthrie
  7. 70 DEF FNCT(I)=BEAT+1/L*(1+.5*ABS(DOTTED=1))
  8. 80 DIM WHOLE%(19),HALF%(19),QUARTER%(19),EIGHTH%(37),SIXTEENTH%(37)
  9. 90 DIM WREST%(4),QREST%(25),EREST%(19),SREST%(21)
  10. 100 DIM CURSOR%(19),DOT%(37),FORBID%(25),NULL%(19),TIED%(10)
  11. 110 DIM FLAT%(15),NATURAL%(16),SHARP%(15)
  12. 120 DIM TREBLE%(73),BASE%(39)
  13. 130 DIM ONE%(39),TWO%(39),THREE%(39),FOUR%(39),EIGHT%(39)
  14. 140 DIM P$(1000),P(1000),KEYS(7)
  15. 150 SCREEN 1:KEY OFF:FOR I=1 TO 10:KEY I,"":NEXT I
  16. 160 BEAT=0:CUREND=0:TIE=0:DOTTED=0:SHARP=0:FLAT=0:NATURAL=0:NOTE=2:REPEAT=-1:POINTER=0
  17. 170 CLS:PRINT TAB(10);"Music package":PRINT TAB(3);"(c) Bruce Guthrie June, 1982"
  18. 180 INPUT "Need instructions [Y/N]? ",A$:IF A$="n" OR A$="N" THEN 220:ELSE IF A$<>"y" AND A$<>"Y" THEN 180
  19. 190 OPEN "music.ins" FOR INPUT AS #1:I=0
  20. 200 I=I+1:IF EOF(1) THEN 220
  21. 210 INPUT #1,A$:PRINT A$:IF I<22 THEN 200:ELSE I=0:INPUT "Press RETURN? ",A$:GOTO 200
  22. 220 GOSUB 1350  'read in PUT definitions for notes
  23. 230 PLAY "MB":CLS:INPUT "Is composition saved already [Y/N]? ",A$:IF A$<>"Y" AND A$<>"y" AND A$<>"N" AND A$<>"n" THEN 230:ELSE IF A$="Y" OR A$="y" THEN GOTO 1190:ELSE CLS:P$(0)="T120":P(0)=-1
  24. 240 GOSUB 2020:NOTE=12 'draw clefs
  25. 250 GOSUB 890        'set key
  26. 260 GOSUB 830        'set bar measure
  27. 270 GOSUB 300        'enter notes
  28. 280 NEWPAGE=0:GOSUB 2050:IF NEWPAGE=1 THEN GOTO 270:ELSE GOSUB 320:GOTO 280
  29. 290 'INPUT NOTE****************************************************************
  30. 300 GOSUB 1910:PRINT"Enter note: sharp(+),flat(-),nat(N),":PRINT "rest(P), 1,2,4,8,S(16th)":PRINT"change key(K),measure(M),tempo(T)"
  31. 310 LOCATE 20,1:PRINT "'1 play, '3 save, '2 tie notes":PRINT ". (dotted note)":' print "[ (begin) and ] (end) repeat"
  32. 320 LOCATE 4,1:PRINT "Use cursor controls to position note. ":GOSUB 1890:PAUSE=0
  33. 330 X$=INKEY$:IF X$="" THEN 330:ELSE IF LEN(X$)=1 THEN 390:ELSE X=ASC(MID$(X$,2))
  34. 340 IF X=59 THEN GOSUB 1890:BEAT=0:GOSUB 1920:GOSUB 1020:GOTO 300 'SF 1 (play song)
  35. 350 IF X=60 THEN GOSUB 1950:IF TIE=1 THEN TIE=0:GOSUB 1950:GOTO 330:ELSE TIE=1:GOSUB 1950:GOTO 330 'SF 2 (tie notes)
  36. 360 IF X=61 THEN GOSUB 1150:GOSUB 1940:NEWPAGE=1:GOTO 300 'SF 3 (save it)
  37. 370 IF X=72 THEN GOSUB 1890:GOSUB 1950:NOTE=NOTE-1:IF NOTE=0 THEN NOTE=25:GOSUB 1890:GOSUB 1950:GOTO 330:ELSE GOSUB 1890:GOSUB 1950:GOTO 330 'cursor up
  38. 380 IF X=80 THEN GOSUB 1890:GOSUB 1950:NOTE=NOTE+1:IF NOTE=26 THEN NOTE=1:GOSUB 1890:GOSUB 1950:GOTO 330:ELSE GOSUB 1890:GOSUB 1950:GOTO 330 'cursor down
  39. 390 A1$=X$:IF A1$="#" THEN A1$="+":ELSE IF A1$>="a" AND A1$<="z" THEN A1$=CHR$(ASC(A1$)-32)
  40. 400 ON INSTR("+-.1248KMNSPT[]",A1$)+1 GOTO 330,520,520,410,440,440,440,440,460,470,520,450,420,500,480,490
  41. 410 GOSUB 1950:IF DOTTED=1 THEN DOTTED=0:GOSUB 1950:GOTO 330:ELSE DOTTED=1:GOSUB 1950:GOTO 330  'dotted note
  42. 420 GOSUB 1920:PRINT "Enter length for this rest? ";:PAUSE=1
  43. 430 A1$=INKEY$:IF LEN(A1$)<>1 THEN 430:ELSE ON INSTR("1248Ss",A1$)+1 GOTO 430,440,440,440,440,450,450
  44. 440 L=VAL(A1$):A1$="0":GOTO 580
  45. 450 L=16:A1$="0":GOTO 580
  46. 460 C=0:GOSUB 1890:GOSUB 890:GOTO 300 'change key
  47. 470 C=0:GOSUB 1890:GOSUB 830:GOTO 300 'change bar measure
  48. 480 'BEGIN REPEAT
  49. 490 'END REPEAT
  50. 500 GOSUB 1920:INPUT "New tempo [32<=x<=255]? ",TEMPO:IF TEMPO<32 OR TEMPO>255 THEN 500
  51. 510 GOSUB 1890:GOSUB 1920:P1$="T"+MID$(STR$(TEMPO+1000),3):INPUT "Play all with this [Y/N]? ",A$:IF A$="Y" THEN P$(0)=P1$:GOTO 300:ELSE IF A$="N" THEN POINTER=CUREND:GOSUB 780:GOTO 300:ELSE GOTO 510
  52. 520 IF A1$="+" AND FORBID%(NOTE)=1 THEN BEEP:GOTO 330:ELSE IF A1$="-" AND FORBID%(NOTE)=2 THEN BEEP:GOTO 330    'checking on flats and sharps
  53. 530 GOSUB 1950:IF A1$="+" THEN IF SHARP=1 THEN SHARP=0:GOSUB 1950:GOTO 330:ELSE SHARP=1:FLAT=0:NATURAL=0:GOSUB 1950:GOTO 330  'sharp
  54. 540 IF A1$="-" THEN IF FLAT=1 THEN FLAT=0:GOSUB 1950:GOTO 330:ELSE FLAT=1:SHARP=0:NATURAL=0:GOSUB 1950:GOTO 330              'flat
  55. 550 IF FLAT=1 THEN NATURAL=0:GOSUB 1950:GOTO 330:ELSE NATURAL=1:FLAT=0:SHARP=0:GOSUB 1950:GOTO 330                           'natural
  56. 560 GOSUB 1920:INPUT "Enter length for this note/rest? ",L:IF L=0 THEN GOSUB 1890:GOTO 320
  57. 570 'DRAW NOTE*****************************************************************
  58. 580 GOSUB 1890:IF FNCT(I)>TOP/BOTTOM THEN GOSUB 1920:PRINT "Note of this length doesn't fit in bar":BEEP:GOSUB 1930:GOTO 320:ELSE GOSUB 590:GOTO 720
  59. 590 IF PAUSE=0 THEN ON L GOTO 660,670,590,680,590,590,590,690,590,590,590,590,590,590,590,700
  60. 600 ON L GOTO 610,620,600,630,600,600,600,640,600,600,600,600,600,600,600,650   'REST NOTES
  61. 610 PUT(WHERE-4,61),WREST%,OR:RETURN
  62. 620 PUT(WHERE-4,67),WREST%,OR:RETURN
  63. 630 PUT(WHERE-4,60),QREST%,OR:RETURN
  64. 640 PUT(WHERE-4,60),EREST%,OR:RETURN
  65. 650 PUT(WHERE-4,60),SREST%,OR:RETURN
  66. 660 PUT (WHERE-4,NOTE*5+38),NULL%,PSET:PUT (WHERE-4,NOTE*5+38),NULL%,XOR:PUT(WHERE-4,NOTE*5+25),WHOLE%,OR:RETURN
  67. 670 PUT (WHERE-4,NOTE*5+38),NULL%,PSET:PUT (WHERE-4,NOTE*5+38),NULL%,XOR:PUT(WHERE-4,NOTE*5+25),HALF%,OR:RETURN
  68. 680 PUT (WHERE-4,NOTE*5+25),QUARTER%,OR:RETURN
  69. 690 PUT (WHERE-4,NOTE*5+25),EIGHTH%,OR:RETURN
  70. 700 PUT (WHERE-4,NOTE*5+25),SIXTEENTH%,OR:RETURN
  71. 710 'FIGURE OUT WHAT TO PLAY***************************************************
  72. 720 IF PAUSE=1 THEN P1$="O3P ":GOTO 740:ELSE P2$=MID$("GFEDCBAGFEDCBAGFEDCBAGFEDCBA",NOTE,1):P1$=P2$:IF NOTE<6 THEN P1$="O4"+P1$:ELSE IF NOTE<13 THEN P1$="O3"+P1$:ELSE IF NOTE<20 THEN P1$="O2"+P1$:ELSE P1$="O1"+P1$
  73. 730 IF FLAT=1 THEN P1$=P1$+"-":ELSE IF SHARP=1 THEN P1$=P1$+"+":ELSE IF NATURAL=1 THEN P1$=P1$+" ":ELSE P1$=P1$+MID$("- +",KEYS(ASC(P2$)-64)+2,1)
  74. 740 IF TIE=1 THEN P1$="ML"+P1$:ELSE P1$="MN"+P1$
  75. 750 P1$=P1$+MID$(STR$(100+L),3):IF DOTTED=1 THEN P1$=P1$+".":ELSE P1$=P1$+" "
  76. 760 ON ERROR GOTO 820:PLAY P1$:ON ERROR GOTO 0
  77. 770 'INSERT NOTE AFTER POINTER*************************************************
  78. 780 N1=P(POINTER):CUREND=CUREND+1:P(POINTER)=CUREND:POINTER=P(POINTER):P$(POINTER)=P1$:P(POINTER)=N1:RETURN
  79. 790 'DELETE NOTE AFTER POINTER*************************************************
  80. 800 P$(P(POINTER))="":P(POINTER)=P(P(POINTER)):RETURN
  81. 810 'ERROR*********************************************************************
  82. 820 GOSUB 1920:PRINT "Sorry.  That note's incorrect.":RESUME 300
  83. 830 'SET TEMPO****************************************************************
  84. 840 GOSUB 1910:INPUT "Bar measure, e.g. 4/4? ",A$
  85. 850 X=INSTR(A$,"/"):IF X=0 THEN PRINT "No division symbol [/].  Re-enter.":GOTO 840:ELSE IF X=1 OR LEN(A$)=X THEN 840
  86. 860 TOP=VAL(MID$(A$,1,X-1)):BOTTOM=VAL(MID$(A$,X+1)):IF MID$("XXXX   X",BOTTOM,1)+MID$("XXXX   X",TOP,1)<>"XX" THEN PRINT "Illegal numbers.  Re-enter.":GOTO 830
  87. 870 P1$="B"+RIGHT$(STR$(TOP),2)+"/"+RIGHT$(STR$(BOTTOM),2):POINTER=CUREND:GOSUB 780:GOTO 2120
  88. 880 'SET KEY******************************************************************
  89. 890 GOSUB 1910:PRINT "Use cursor controls [up/down] and +/-":PRINT "keys to position/set flats and sharps.":PRINT "Use CR to stop.  Do top clef only."
  90. 900 FOR I=1 TO 7:KEYS(I)=0:NEXT I:NOTE=2
  91. 910 GOSUB 1900
  92. 920 X$=INKEY$:IF X$="" THEN 920
  93. 930 IF X$="+" OR X$="#" THEN IF FORBID%(NOTE)=1 THEN BEEP:GOTO 920:ELSE I=1:GOSUB 1000:PUT(WHERE+4,NOTE*5+32),SHARP%,XOR:GOTO 920
  94. 940 IF X$="-" THEN IF FORBID%(NOTE)=2 THEN BEEP:GOTO 920:ELSE I=-1:GOSUB 1000:PUT(WHERE+4,NOTE*5+32),FLAT%,XOR:GOTO 920
  95. 950 IF ASC(X$)=13 THEN P1$="K":FOR I=0 TO 7:P1$=P1$+STR$(KEYS(I)):NEXT I:POINTER=CUREND:GOSUB 780:GOSUB 1900:GOSUB 2080:WHERE=WHERE+4:NOTE=12:RETURN  'carriage return
  96. 960 IF LEN(X$)<2 THEN 920:ELSE X=ASC(MID$(X$,2))
  97. 970 IF X=72 THEN GOSUB 1900:NOTE=NOTE-1:IF NOTE=0 THEN NOTE=7:GOSUB 1900:ELSE GOSUB 1900
  98. 980 IF X=80 THEN GOSUB 1900:NOTE=NOTE+1:IF NOTE=8 THEN NOTE=1:GOSUB 1900:ELSE GOSUB 1900
  99. 990 GOTO 920
  100. 1000 IF KEYS(8-NOTE)=I THEN KEYS(0)=KEYS(0)-1:KEYS(8-NOTE)=0:RETURN:ELSE IF KEYS(8-NOTE)=-I THEN KEYS(8-NOTE)=I:RETURN:ELSE KEYS(8-NOTE)=I:KEYS(0)=KEYS(0)+1:RETURN
  101. 1010 'PLAY IT WHILE DRAWING IT*************************************************
  102. 1020 GOSUB 2020:E=0:WHILE E>-1:A$=P$(E):A1$=MID$(A$,1,1)
  103. 1030 IF A1$="T" THEN PLAY A$:GOTO 1130
  104. 1040 IF A1$="B" THEN TOP=VAL(MID$(A$,2,2)):BOTTOM=VAL(MID$(A$,5,2)):GOSUB 2120:GOTO 1130
  105. 1050 IF A1$="K" THEN FOR I=0 TO 7:KEYS(I)=VAL(MID$(A$,I*2+2,2)):NEXT I:GOSUB 2080:GOTO 1130
  106. 1060 IF A1$="R" THEN  'repeats
  107. 1070 IF MID$(A$,1,2)="ML" THEN TIE=1:ELSE TIE=0
  108. 1080 L=VAL(MID$(A$,7,2)):A1$=MID$(A$,5,1):IF A1$="P" THEN PAUSE=1:GOTO 1110
  109. 1090 PAUSE=0:NOTE=(4-VAL(MID$(A$,4,1)))*7-2+INSTR("BAGFEDC",A1$):T1$=MID$(A$,6,1):IF T1$="+" THEN SHARP=1:ELSE IF T1$="-" THEN FLAT=1
  110. 1100 IF MID$(A$,9,1)="." THEN DOTTED=1
  111. 1110 WHERE=WHERE+(SHARP+FLAT+NATURAL)*4:GOSUB 1950:GOSUB 590
  112. 1120 PLAY A$:GOSUB 2050
  113. 1130 E=P(E):WEND:RETURN
  114. 1140 'SAVE IT******************************************************************
  115. 1150 CLS:I1=0:ON ERROR GOTO 1280:INPUT "Name of composition? ",N$:PRINT "Name of file to save as":GOSUB 1240:IF A$="Q" THEN 1940
  116. 1160 OPEN FI$ FOR OUTPUT AS #1:WRITE #1,DATE$,N$,CUREND
  117. 1170 FOR I=0 TO CUREND:WRITE#1,P(I),P$(I):NEXT I:CLOSE #1:PRINT "Saved!!":BEEP:GOSUB 1930:ON ERROR GOTO 0:RETURN
  118. 1180 'LOAD IT******************************************************************
  119. 1190 CLS:I1=1:ON ERROR GOTO 1280:PRINT "Name of file to load composition from?":GOSUB 1240:IF A$="Q" THEN 230
  120. 1200 OPEN FI$ FOR INPUT AS #1:INPUT #1,A$,N$,CUREND
  121. 1210 FOR I=0 TO CUREND:INPUT#1,P(I),P$(I):NEXT I:CLOSE #1
  122. 1220 PRINT "The name of this composition is:":PRINT N$:PRINT "File was last saved on ";A$:GOSUB 1930
  123. 1230 PRINT "Loaded!":BEEP:GOSUB 1930:ON ERROR GOTO 0:GOSUB 1020:GOTO 270
  124. 1240 INPUT "(DEF ext=MUS)? ",FI$:IF INSTR(FI$,".") = 0 THEN FI$=FI$+".MUS"
  125. 1241 IF FI$=".MUS" THEN PRINT "Expecting file name.":PRINT "File name ";:GOTO 1240
  126. 1250 IF INSTR(FI$,":")=0 THEN INPUT "Device A or B? ",A$:IF LEN(A$)<>1 THEN 1250:ELSE FI$=A$+":"+FI$
  127. 1260 INPUT "Insert disk.  Press RETURN (Q=quit)? ",A$:IF A$="Q" THEN ON ERROR GOTO 0:RETURN:ELSE RETURN
  128. 1270 'ERROR-TRAPPING ROUTINE***************************************************
  129. 1280 IF ERR=53 THEN PRINT "File of this name is not on disk.":PRINT "Try another disk or give up.":GOTO 1330
  130. 1290 IF ERR=61 THEN PRINT "Ran out of room on the disk for this":PRINT "file.  Try another disk or give up.":GOTO 1330
  131. 1300 IF ERR=62 THEN PRINT "Hmm.  It says we're out of data.":PRINT "Perhaps your file was created by an":PRINT "earlier version of this routine.":PRINT "Skip loading it here.":GOTO 1330
  132. 1310 IF ERR=64 THEN PRINT "What the hell was that name you input?":PRINT "It didn't go over at all!":PRINT "Try again or give up.":GOTO 1330
  133. 1320 ON ERROR GOTO 0:RESUME
  134. 1330 GOSUB 1930:IF I1=1 THEN RESUME 1190:ELSE RESUME 1150
  135. 1340 'READ NOTE VALUES*********************************************************
  136. 1350 PRINT:PRINT "Reading note character definitions..."
  137. 1360 DATA 16,05,-241,-193,-193,-193,-1009
  138. 1370 FOR I=0 TO 6:READ NULL%(I):NEXT I 'USED AS PUT(X,Y),NULL%,PRESET TO CLEAR OUT FOR WHOLE% AND HALF%
  139. 1380 DATA 3,2,1,3,2,1,3,3,2,1,3,2,1,3,3,2,1,3,2,1,3,3,2,1,3
  140. 1390 FOR I=1 TO 25:READ FORBID%(I):NEXT I
  141. 1400 DATA 16,18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-193,-193,-193,0
  142. 1410 FOR I=0 TO 19:READ CURSOR%(I):NEXT I
  143. 1420 DATA 16,18,0,0,0,0,0,0,0,0,0,0,0,0,0,-241,816,816,816,-1009
  144. 1430 FOR I=0 TO 19:READ WHOLE%(I):NEXT I
  145. 1440 DATA 16,18,768,768,768,768,768,768,768,768,768,768,768,768,768,-241,816,816,816,-1009
  146. 1450 FOR I=0 TO 19:READ HALF%(I):NEXT I
  147. 1460 DATA 16,18,768,768,768,768,768,768,768,768,768,768,768,768,768,-241,-193,-193,-193,-1009
  148. 1470 FOR I=0 TO 19:READ QUARTER%(I):NEXT I
  149. 1480 DATA 32,18,768,192,768,48,768,12,768,3,768,-16384,768,-16384,768,-16384,768,-16384,768,-16384,768,0,768,0,768,0,768,0,-241,0,-193,0,-193,0,-193,0,-1009,0
  150. 1490 FOR I=0 TO 37:READ EIGHTH%(I):NEXT I
  151. 1500 DATA 32,18,768,192,768,48,768,12,768,3,768,-16192,768,-16336,768,-16372,768,-16381,768,-16384,768,-16384,768,-16384,768,-16384,768,-16384,-241,0,-193,0,-193,0,-193,0,-1009,0
  152. 1510 FOR I=0 TO 37:READ SIXTEENTH%(I):NEXT I
  153. 1520 DATA 32,18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,60,0,60,0,0,0,0
  154. 1530 FOR I=0 TO 37:READ DOT%(I):NEXT I
  155. 1540 DATA 16,3,-961,-961,-961
  156. 1550 FOR I=0 TO 4:READ WREST%(I):NEXT I
  157. 1560 DATA 18,16,0,0,192,-4096,0,60,-4096,768,192,15,3840,0,-16381,0,240,-1021,3840,0,60,15360,0,12,0,0
  158. 1570 FOR I=0 TO 25:READ QREST%(I):NEXT I
  159. 1580 DATA 18,12,0,0,0,3072,15360,48,12348,3840,192,-16384,768,0,3,3072,0,12,0,0
  160. 1590 FOR I=0 TO 19:READ EREST%(I):NEXT I
  161. 1600 DATA 22,13,0,0,-16384,-15613,768,195,-1024,15360,12,12348,3840,240,-16384,0,192,3,768,0,0,0
  162. 1610 FOR I=0 TO 21:READ SREST%(I):NEXT I
  163. 1620 DATA 12,14,0,-16384,-4084,-4081,-16321,-16324,-16372,-16372,-4084,-4081,-16321,-16324,12,0
  164. 1630 FOR I=0 TO 15:READ SHARP%(I):NEXT I
  165. 1640 DATA 14,14,0,48,48,48,48,48,-16333,12348,12336,-16336,51,60,48,0
  166. 1650 FOR I=0 TO 15:READ FLAT%(I):NEXT I
  167. 1660 DATA 12,15,0,0,48,48,63,63,51,51,51,63,63,3,3,0,0
  168. 1670 FOR I=0 TO 16:READ NATURAL%(I):NEXT I
  169. 1680 DATA 30,36,0,0,0,0,768,192,3840,240,15360,60,15360,60,15360,60,15360,240,3840,192
  170. 1690 DATA 3840,0,16128,0,-256,0,-3325,0,-15613,0,-15601,0,831,0,828,0,828,192,60,192
  171. 1700 DATA 60,192,3900,255,15420,-16177,12303,-16189,15,-16189,15,-16189,-16381,207,-4093,252,-256,240,0,48
  172. 1710 DATA 0,48,0,48,-1024,48,-1024,48,-256,192,0,0,0,0
  173. 1720 FOR I=0 TO 73:READ TREBLE%(I):NEXT I
  174. 1730 DATA 30,19,0,0,0,0,-253,192,783,-3856,12,-3844,-16369,60,-16369,60,-16369,-4036,0,-4036
  175. 1740 DATA 0,240,0,240,768,192,3840,0,15360,0,-4096,0,-16381,0,15,0,12,0,0,0
  176. 1750 FOR I=0 TO 39:READ BASE%(I):NEXT I
  177. 1760 DATA 48,3,240,0,-4096,63,0,-16369,-253,-1,252
  178. 1770 FOR I=0 TO 10:READ TIED%(I):NEXT I
  179. 1780 DATA 26,19,-4093,0,-1009,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-1024,0,-241,192,-241,192
  180. 1790 FOR I=0 TO 39:READ ONE%(I):NEXT I
  181. 1800 DATA 26,19,-241,0,-193,192,828,192,828,192,768,192,768,192,3840,0,15360,0,-4096,0,-16381,0,15,0,60,0,60,0,60,0,60,0,60,0,828,192,-193,192,-193,192
  182. 1810 FOR I=0 TO 39:READ TWO%(I):NEXT I
  183. 1820 DATA 26,19,-1009,0,-193,0,3900,0,3840,0,3840,0,3840,0,3840,0,3840,0,-1009,0,-1009,0,3840,0,3840,0,3840,0,3840,0,3840,0,3840,0,3900,0,-193,0,-1009,0
  184. 1830 FOR I=0 TO 39:READ THREE%(I):NEXT I
  185. 1840 DATA 26,19,16128,0,-256,0,-256,0,-12541,0,-12541,0,3855,0,3855,0,3900,0,3900,0,-1,192,-1,192,3840,0,3840,0,3840,0,3840,0,3840,0,3840,0,3840,0,3840,0
  186. 1850 FOR I=0 TO 39:READ FOUR%(I):NEXT I
  187. 1860 DATA 26,19,-253,0,-253,0,783,192,783,192,783,192,783,192,783,192,783,192,-253,0,-253,0,783,192,783,192,783,192,783,192,783,192,783,192,783,192,-241,192,-253,0
  188. 1870 FOR I=0 TO 39:READ EIGHT%(I):NEXT I
  189. 1880 RETURN
  190. 1890 PUT(WHERE-4,NOTE*5+25),CURSOR%,XOR:RETURN   'draw cursor for notes
  191. 1900 PUT(WHERE+1,NOTE*5+25),CURSOR%,XOR:RETURN   'draw cursor for keys
  192. 1910 LOCATE 1,1:PRINT SPACE$(160):LOCATE 1,1:RETURN    'clear top 4 lines
  193. 1920 LOCATE 4,1:PRINT SPACE$(39):LOCATE 4,1:RETURN     'clear line 4
  194. 1930 FOR I=1 TO 1000:NEXT I:RETURN                     'time waster
  195. 1940 GOSUB 2020:GOSUB 2080:GOSUB 2120:RETURN           'draws in screen
  196. 1950 IF TIE=1 THEN PUT(WHERE-5,NOTE*5+47),TIED%        'draws ties if needed
  197. 1960 IF DOTTED=1 THEN PUT(WHERE-4,NOTE*5+25),DOT%  'draws dotted notes if needed
  198. 1970 IF SHARP=1 THEN PUT(WHERE-8,NOTE*5+32),SHARP%     'draws sharps
  199. 1980 IF FLAT=1 THEN PUT(WHERE-8,NOTE*5+32),FLAT%       'draws flats
  200. 1990 IF NATURAL=1 THEN PUT(WHERE-8,NOTE*5+32),NATURAL% 'draws naturals
  201. 2000 RETURN
  202. 2010 'DRAW CLEFS***************************************************************
  203. 2020 CLS:FOR I=50 TO 150 STEP 10:IF I<>100 THEN LINE(0,I)-STEP(319,0),2
  204. 2030 NEXT I:LINE (0,50)-(0,150):PUT(0,50),TREBLE%,OR:PUT(0,115),BASE%,OR:WHERE=10:RETURN
  205. 2040 'ADDS BARS, REDRAWS AS NECESSARY******************************************
  206. 2050 BEAT=FNCT(L):IF BEAT>=TOP/BOTTOM THEN LINE(WHERE+10,50)-STEP(0,100):BEAT=0
  207. 2060 WHERE=WHERE+14+DOTTED*4:TIE=0:DOTTED=0:SHARP=0:NATURAL=0:FLAT=0:IF WHERE>305 THEN GOSUB 1940:NEWPAGE=1:RETURN:ELSE RETURN
  208. 2070 'DRAW EXISTING KEY STRUCTURE**********************************************
  209. 2080 IF KEYS(0)=0 THEN RETURN
  210. 2090 FOR I=1 TO 7:IF KEYS(8-I)=1 THEN FOR N1=I TO 25 STEP 7:PUT(WHERE+4,N1*5+32),SHARP%,OR:NEXT N1:ELSE IF KEYS(8-I)=-1 THEN FOR N1=I TO 25 STEP 7:PUT(WHERE+4,N1*5+32),FLAT%,OR:NEXT N1
  211. 2100 NEXT I:WHERE=WHERE+10:RETURN
  212. 2110 'DRAW MEASURES************************************************************
  213. 2120 I1=0:ON TOP GOSUB 2130,2140,2150,2160,2160,2160,2160,2170:I1=20:ON BOTTOM GOSUB 2130,2140,2150,2160,2160,2160,2160,2170:WHERE=WHERE+20:RETURN
  214. 2130 FOR I=50+I1 TO 110+I1 STEP 60:PUT(WHERE+4,I),ONE%,OR:NEXT I:RETURN
  215. 2140 FOR I=50+I1 TO 110+I1 STEP 60:PUT(WHERE+4,I),TWO%,OR:NEXT I:RETURN
  216. 2150 FOR I=50+I1 TO 110+I1 STEP 60:PUT(WHERE+4,I),THREE%,OR:NEXT I:RETURN
  217. 2160 FOR I=50+I1 TO 110+I1 STEP 60:PUT(WHERE+4,I),FOUR%,OR:NEXT I:RETURN
  218. 2170 FOR I=50+I1 TO 110+I1 STEP 60:PUT(WHERE+4,I),EIGHT%,OR:NEXT I:RETURN
  219.